Actualmente el sistema financiero cuenta con una penetración de tarjetas de crédito del 57,3% en la población bancarizada de Colombia, según estudio realizado por la compañía Minsait por medio de su informe Tendencias en Medios de Pago 2018. Lo cual lleva a la industria a tener grandes retos a nivel de facturación y mejoramiento del servicio, fomentando el uso del dinero plástico. De acuerdo a información de la Superintendencia Financiera de Colombia, el país cuenta con alrededor de 15 millones de plásticos vigentes emitidos, siendo el cuarto país entre 18 países latinoamericanos con mayor número de plásticos.
Tomando una muestra de clientes de una entidad bancaria, se quiere identificar segmentos para desarrollar estrategias particulares dependiendo de las características de cada grupo. Estas estrategias pueden ser de fidelización a largo plazo, adquisición de nuevos servicios, aumento de frecuencia del uso de tarjeta de crédito, entre otras.
Se tiene una base de clientes simulada de una entidad bancaria X, la cual consta del historial transaccional desde el segundo semestre del 2017 hasta el primer semestre del 2019.
Esta base cuenta con 4.999 clientes, cuenta con información demográfica y transaccional.
Directorio de trabajo
setwd("D:/Usuarios/danirorm/Seguros Suramericana, S.A/PROYECTO_MAESTRIA_EAFIT - General/3-Data")
Importación de los datos
#librerias
library(readr)
## Warning: package 'readr' was built under R version 3.4.4
library(dplyr)
## Warning: package 'dplyr' was built under R version 3.4.4
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(plotly)
## Warning: package 'plotly' was built under R version 3.4.4
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 3.4.4
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(PerformanceAnalytics)
## Warning: package 'PerformanceAnalytics' was built under R version 3.4.4
## Loading required package: xts
## Warning: package 'xts' was built under R version 3.4.4
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 3.4.4
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Attaching package: 'xts'
## The following objects are masked from 'package:dplyr':
##
## first, last
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
library(cluster)
## Warning: package 'cluster' was built under R version 3.4.4
library(factoextra)
## Warning: package 'factoextra' was built under R version 3.4.4
## Welcome! Related Books: `Practical Guide To Cluster Analysis in R` at https://goo.gl/13EFCZ
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 3.4.4
## -- Attaching packages --------------------------------- tidyverse 1.2.1 --
## v tibble 2.1.1 v purrr 0.3.0
## v tidyr 0.8.3 v stringr 1.4.0
## v tibble 2.1.1 v forcats 0.4.0
## Warning: package 'tibble' was built under R version 3.4.4
## Warning: package 'tidyr' was built under R version 3.4.4
## Warning: package 'purrr' was built under R version 3.4.4
## Warning: package 'stringr' was built under R version 3.4.4
## Warning: package 'forcats' was built under R version 3.4.4
## -- Conflicts ------------------------------------ tidyverse_conflicts() --
## x plotly::filter() masks dplyr::filter(), stats::filter()
## x xts::first() masks dplyr::first()
## x dplyr::lag() masks stats::lag()
## x xts::last() masks dplyr::last()
library(ggpubr)
## Warning: package 'ggpubr' was built under R version 3.4.4
## Loading required package: magrittr
## Warning: package 'magrittr' was built under R version 3.4.4
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
## The following object is masked from 'package:tidyr':
##
## extract
#importar data
options("scipen"=100, "digits"=4)
data_full<- read_delim("Base_modelo.csv",
";", escape_double = FALSE, trim_ws = TRUE)
## Parsed with column specification:
## cols(
## .default = col_double(),
## Sexo = col_character(),
## Grupo_valor = col_character(),
## Rango_ingresos_acum = col_number(),
## Nivel_estudio = col_character(),
## Estado_civil = col_character(),
## Departamento = col_character(),
## Hijos = col_character(),
## Franquicia = col_character(),
## canal = col_character(),
## origen = col_character(),
## Monto_transado = col_number()
## )
## See spec(...) for full column specifications.
Estructura de la base
#Estructura de la base
str(data_full)
## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 4999 obs. of 41 variables:
## $ Cliente_Id : num 8408675 9705704 9661841 7602888 21018130 ...
## $ Sexo : chr "M" "M" "M" "M" ...
## $ Estrato : num 5 4 4 6 6 6 6 4 6 5 ...
## $ Grupo_valor : chr "Alto" "Alto" "Alto" "Alto" ...
## $ Rango_ingresos_acum: num 7500000 25500000 22500000 36000000 30000000 12000000 51000000 46500000 24000000 12000000 ...
## $ Nivel_estudio : chr "Maestria" "Especializacion" "Pregrado" "Maestria" ...
## $ Estado_civil : chr "VIUDO" "VIUDO" "VIUDO" "SOLTERO" ...
## $ Departamento : chr "BOGOTA D.C." "BOGOTA D.C." "BOGOTA D.C." "BOGOTA D.C." ...
## $ Edad : num 111 101 94 92 92 92 91 91 91 90 ...
## $ Hijos : chr "0" "?" "?" "0" ...
## $ Franquicia : chr "AMEX" "VISA" "AMEX" "AMEX" ...
## $ canal : chr "I" "P" "I" "I" ...
## $ origen : chr "Nacional" "Nacional" "Nacional" "Nacional" ...
## $ Monto_transado : num 5578975 10091850 22784577 15884697 53528566 ...
## $ Reclamos : num 2 2 2 2 2 2 2 3 2 2 ...
## $ cnt_trx_201706 : num 16 3 5 5 15 10 1 10 4 10 ...
## $ cnt_trx_201707 : num 19 1 9 12 6 7 3 2 41 14 ...
## $ cnt_trx_201708 : num 16 4 11 11 1 2 2 4 22 11 ...
## $ cnt_trx_201709 : num 24 3 9 6 1 12 0 3 45 21 ...
## $ cnt_trx_201710 : num 16 8 3 8 5 3 0 0 25 12 ...
## $ cnt_trx_201711 : num 22 14 3 4 1 14 0 2 29 6 ...
## $ cnt_trx_201712 : num 6 4 9 12 2 5 0 0 38 5 ...
## $ cnt_trx_201801 : num 15 5 2 18 0 3 0 0 2 4 ...
## $ cnt_trx_201802 : num 0 4 2 2 0 7 0 0 0 8 ...
## $ cnt_trx_201803 : num 0 0 3 5 0 3 0 6 0 8 ...
## $ cnt_trx_201804 : num 0 11 2 5 1 5 0 2 4 6 ...
## $ cnt_trx_201805 : num 0 2 3 2 5 8 0 5 0 19 ...
## $ cnt_trx_201806 : num 0 3 2 1 6 9 0 11 0 19 ...
## $ cnt_trx_201807 : num 0 3 17 1 12 9 0 10 0 12 ...
## $ cnt_trx_201808 : num 0 1 7 1 3 1 0 10 1 0 ...
## $ cnt_trx_201809 : num 0 2 3 7 0 9 0 8 0 0 ...
## $ cnt_trx_201810 : num 0 9 4 6 0 8 0 35 20 2 ...
## $ cnt_trx_201811 : num 0 3 4 1 1 3 0 19 5 0 ...
## $ cnt_trx_201812 : num 1 0 5 6 1 5 0 4 4 2 ...
## $ cnt_trx_201901 : num 0 1 4 1 0 2 0 5 0 0 ...
## $ cnt_trx_201902 : num 0 0 2 2 0 4 0 4 0 1 ...
## $ cnt_trx_201903 : num 0 2 6 1 0 5 0 7 0 0 ...
## $ cnt_trx_201904 : num 0 1 2 10 0 5 0 1 0 0 ...
## $ cnt_trx_201905 : num 0 3 3 0 0 6 0 12 3 0 ...
## $ cnt_trx_201906 : num 0 1 4 0 1 2 0 2 1 2 ...
## $ Total_trx : num 135 88 124 127 61 147 6 162 244 162 ...
## - attr(*, "spec")=
## .. cols(
## .. Cliente_Id = col_double(),
## .. Sexo = col_character(),
## .. Estrato = col_double(),
## .. Grupo_valor = col_character(),
## .. Rango_ingresos_acum = col_number(),
## .. Nivel_estudio = col_character(),
## .. Estado_civil = col_character(),
## .. Departamento = col_character(),
## .. Edad = col_double(),
## .. Hijos = col_character(),
## .. Franquicia = col_character(),
## .. canal = col_character(),
## .. origen = col_character(),
## .. Monto_transado = col_number(),
## .. Reclamos = col_double(),
## .. cnt_trx_201706 = col_double(),
## .. cnt_trx_201707 = col_double(),
## .. cnt_trx_201708 = col_double(),
## .. cnt_trx_201709 = col_double(),
## .. cnt_trx_201710 = col_double(),
## .. cnt_trx_201711 = col_double(),
## .. cnt_trx_201712 = col_double(),
## .. cnt_trx_201801 = col_double(),
## .. cnt_trx_201802 = col_double(),
## .. cnt_trx_201803 = col_double(),
## .. cnt_trx_201804 = col_double(),
## .. cnt_trx_201805 = col_double(),
## .. cnt_trx_201806 = col_double(),
## .. cnt_trx_201807 = col_double(),
## .. cnt_trx_201808 = col_double(),
## .. cnt_trx_201809 = col_double(),
## .. cnt_trx_201810 = col_double(),
## .. cnt_trx_201811 = col_double(),
## .. cnt_trx_201812 = col_double(),
## .. cnt_trx_201901 = col_double(),
## .. cnt_trx_201902 = col_double(),
## .. cnt_trx_201903 = col_double(),
## .. cnt_trx_201904 = col_double(),
## .. cnt_trx_201905 = col_double(),
## .. cnt_trx_201906 = col_double(),
## .. Total_trx = col_double()
## .. )
dim(data_full)
## [1] 4999 41
#Nombres de las columnas
names(data_full)
## [1] "Cliente_Id" "Sexo" "Estrato"
## [4] "Grupo_valor" "Rango_ingresos_acum" "Nivel_estudio"
## [7] "Estado_civil" "Departamento" "Edad"
## [10] "Hijos" "Franquicia" "canal"
## [13] "origen" "Monto_transado" "Reclamos"
## [16] "cnt_trx_201706" "cnt_trx_201707" "cnt_trx_201708"
## [19] "cnt_trx_201709" "cnt_trx_201710" "cnt_trx_201711"
## [22] "cnt_trx_201712" "cnt_trx_201801" "cnt_trx_201802"
## [25] "cnt_trx_201803" "cnt_trx_201804" "cnt_trx_201805"
## [28] "cnt_trx_201806" "cnt_trx_201807" "cnt_trx_201808"
## [31] "cnt_trx_201809" "cnt_trx_201810" "cnt_trx_201811"
## [34] "cnt_trx_201812" "cnt_trx_201901" "cnt_trx_201902"
## [37] "cnt_trx_201903" "cnt_trx_201904" "cnt_trx_201905"
## [40] "cnt_trx_201906" "Total_trx"
Se evidencia una fuerta presencia de registros faltantes identificados como “-1” o ?. Según el conocimiento del experto estos datos se clasifican como NA’S.
Se crearán funciones con el objetivo de identificar estos datos y analizarlos.
# Función usada para determinar el porcentaje de datos faltantes en un set de datos
missingData <- function(data) {
print("Porcentaje NA's en cada Columna")
# Porcentaje de NA's en cada Columna
porcNA <- round(sapply(data, function(y) sum(is.na(y)))/nrow(data)*100, 2)
print(porcNA[porcNA > 0])
print("Porcentaje de Registros con valor de -1 en cada columna")
# Porcentaje de Variables sin Información en Cada Columna
porcSinInf <- round(sapply(data, function(y) sum(as.character(y) == '-1', na.rm = T))/nrow(data)*100, 2)
print(porcSinInf[porcSinInf > 0])
print("Porcentaje de Registros con valor de ? en cada columna")
# Porcentaje de Variables sin Información en Cada Columna
porcSinInf <- round(sapply(data, function(y) sum(as.character(y) == '?', na.rm = T))/nrow(data)*100, 2)
print(porcSinInf[porcSinInf > 0])
}
Para empezar la limpieza de los datos, se debe conocer como estan los datos con un summary de la base.
#Resumen de la base
summary(data_full)
## Cliente_Id Sexo Estrato Grupo_valor
## Min. : 23206 Length:4999 Min. :1.00 Length:4999
## 1st Qu.:12254482 Class :character 1st Qu.:4.00 Class :character
## Median :25172803 Mode :character Median :5.00 Mode :character
## Mean :24886674 Mean :4.95
## 3rd Qu.:37386930 3rd Qu.:6.00
## Max. :49430008 Max. :6.00
## Rango_ingresos_acum Nivel_estudio Estado_civil
## Min. : 450000 Length:4999 Length:4999
## 1st Qu.: 6900000 Class :character Class :character
## Median : 13500000 Mode :character Mode :character
## Mean : 17178331396
## 3rd Qu.: 22500000
## Max. :21681818181000
## Departamento Edad Hijos Franquicia
## Length:4999 Min. : 25.0 Length:4999 Length:4999
## Class :character 1st Qu.: 34.0 Class :character Class :character
## Mode :character Median : 44.0 Mode :character Mode :character
## Mean : 45.5
## 3rd Qu.: 56.0
## Max. :111.0
## canal origen Monto_transado Reclamos
## Length:4999 Length:4999 Min. : 0 Min. : 2.00
## Class :character Class :character 1st Qu.: 3630950 1st Qu.: 2.00
## Mode :character Mode :character Median : 9081903 Median : 2.00
## Mean :15111380 Mean : 2.51
## 3rd Qu.:19445268 3rd Qu.: 3.00
## Max. :98744657 Max. :14.00
## cnt_trx_201706 cnt_trx_201707 cnt_trx_201708 cnt_trx_201709
## Min. : 0.00 Min. : 0.00 Min. : 0.00 Min. : 0.00
## 1st Qu.: 2.00 1st Qu.: 2.00 1st Qu.: 2.00 1st Qu.: 1.00
## Median : 4.00 Median : 5.00 Median : 5.00 Median : 4.00
## Mean : 6.66 Mean : 9.48 Mean : 8.84 Mean : 8.51
## 3rd Qu.: 8.00 3rd Qu.: 12.00 3rd Qu.: 11.00 3rd Qu.: 11.00
## Max. :101.00 Max. :143.00 Max. :182.00 Max. :202.00
## cnt_trx_201710 cnt_trx_201711 cnt_trx_201712 cnt_trx_201801
## Min. : 0.00 Min. : 0.0 Min. : 0.00 Min. : 0.00
## 1st Qu.: 1.00 1st Qu.: 1.0 1st Qu.: 1.00 1st Qu.: 0.00
## Median : 4.00 Median : 4.0 Median : 4.00 Median : 3.00
## Mean : 8.48 Mean : 8.4 Mean : 8.17 Mean : 7.43
## 3rd Qu.: 10.00 3rd Qu.: 11.0 3rd Qu.: 10.00 3rd Qu.: 9.00
## Max. :220.00 Max. :216.0 Max. :173.00 Max. :253.00
## cnt_trx_201802 cnt_trx_201803 cnt_trx_201804 cnt_trx_201805
## Min. : 0 Min. : 0.0 Min. : 0.0 Min. : 0.0
## 1st Qu.: 0 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0.0
## Median : 2 Median : 3.0 Median : 3.0 Median : 2.0
## Mean : 7 Mean : 7.5 Mean : 7.3 Mean : 7.3
## 3rd Qu.: 8 3rd Qu.: 9.0 3rd Qu.: 9.0 3rd Qu.: 9.0
## Max. :404 Max. :427.0 Max. :515.0 Max. :430.0
## cnt_trx_201806 cnt_trx_201807 cnt_trx_201808 cnt_trx_201809
## Min. : 0 Min. : 0.00 Min. : 0.00 Min. : 0.00
## 1st Qu.: 0 1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.: 0.00
## Median : 2 Median : 2.00 Median : 2.00 Median : 1.00
## Mean : 7 Mean : 6.69 Mean : 6.41 Mean : 5.86
## 3rd Qu.: 8 3rd Qu.: 8.00 3rd Qu.: 7.00 3rd Qu.: 7.00
## Max. :210 Max. :192.00 Max. :201.00 Max. :164.00
## cnt_trx_201810 cnt_trx_201811 cnt_trx_201812 cnt_trx_201901
## Min. : 0.00 Min. : 0.00 Min. : 0.00 Min. : 0.00
## 1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.: 0.00
## Median : 1.00 Median : 1.00 Median : 1.00 Median : 0.00
## Mean : 6.44 Mean : 5.78 Mean : 5.52 Mean : 4.81
## 3rd Qu.: 7.00 3rd Qu.: 6.00 3rd Qu.: 6.00 3rd Qu.: 5.00
## Max. :221.00 Max. :207.00 Max. :124.00 Max. :111.00
## cnt_trx_201902 cnt_trx_201903 cnt_trx_201904 cnt_trx_201905
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.00
## 1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.: 0.0 1st Qu.: 0.00
## Median : 0.00 Median : 0.00 Median : 0.0 Median : 0.00
## Mean : 4.73 Mean : 4.53 Mean : 4.6 Mean : 4.83
## 3rd Qu.: 5.00 3rd Qu.: 4.00 3rd Qu.: 4.0 3rd Qu.: 4.00
## Max. :135.00 Max. :120.00 Max. :158.0 Max. :185.00
## cnt_trx_201906 Total_trx
## Min. : 0.00 Min. : 0
## 1st Qu.: 0.00 1st Qu.: 40
## Median : 0.00 Median : 92
## Mean : 4.32 Mean : 167
## 3rd Qu.: 4.00 3rd Qu.: 200
## Max. :142.00 Max. :3293
Al ver el resumen de la base , se evidencia observaciones que se salen del pormedio y que son minoría de la muestra obtenida por lo tanto se contextualiza con el conocimiento del experto y se filtra por rango de ingresos y así tendremos mas exactitud en los resultados de la población estudiada.
Se filtra por rango de ingresos acumulados año entre 450 mil y 90 millones, luego el nuevo data set queda como data1
#Rango de ingresos acumulados al año entre 450 mil y 90 millones
data1<-data_full %>% filter(Rango_ingresos_acum %in% (450000:90000000))
Identificación de caracteres especiales
Función para encontrar el porcentaje de missing data
missingData(data1)
## [1] "Porcentaje NA's en cada Columna"
## named numeric(0)
## [1] "Porcentaje de Registros con valor de -1 en cada columna"
## named numeric(0)
## [1] "Porcentaje de Registros con valor de ? en cada columna"
## Hijos
## 77.07
En la columna Hijos se identifica caracteres como ?
head(data1$Hijos)
## [1] "0" "?" "?" "0" "?" "1"
Se evidencia que el 77,07% de los registros tienen el caracter especial de “?” , como no se pueden eliminar sin ser tratados se pueden guardar en una base para luego analizarlos y mejorar los datos pero por ahora no se trabajaran con estos registros NA’S.
Datos con “?”
datosconsigno<-data1 %>% filter(Hijos=="?")
dim(datosconsigno)
## [1] 3848 41
Nuevo dataset = data1
data1<-data1 %>% filter(Hijos!="?")
El monto transado debe ser mayor que cero, data2 nuevo dataset
data2<-data1 %>% filter(Monto_transado != 0 )
Edad
# Ahora vamos a analizar como se distribuye la poblacion
plot_ly(data2, x = ~Edad, type = "histogram")%>% config(displayModeBar = F)
La población de estudio esta entre 25 y 60 años
#la poblacion estudio esta entre 25 y 60 años
data3<-data2 %>% filter(Edad %in% (25:60))
#histograma
plot_ly(data3, x = ~Edad, type = "histogram")%>% config(displayModeBar = F)
#boxplot
plot_ly(data3, y = ~Edad, type = "box")
Nuevo dataset = data3
Distribución por género
#Distribucion por genero
table(data3$Sexo)
##
## F M
## 407 463
sort(prop.table(table(data3$Sexo))*100, decreasing = T)
##
## M F
## 53.22 46.78
Se evidencia en la poblacion que el 53.22% son Hombres y el 46.7% son Mujeres.
Nivel de estudio
#Distribución por Nivel estudio
table(data3$Nivel_estudio)
##
## Bachiller Especializacion Maestria Pregrado
## 5 495 192 156
## tecnico Tecnologo
## 17 5
sort(prop.table(table(data3$Nivel_estudio))*100, decreasing = T)
##
## Especializacion Maestria Pregrado tecnico
## 56.8966 22.0690 17.9310 1.9540
## Bachiller Tecnologo
## 0.5747 0.5747
plot_ly(data3, x = ~Nivel_estudio, type = "histogram")%>% config(displayModeBar = F)
Se evidencia una participación del 56,8% de personas que tienen nivel de estudios con especialización.
Estado civil
#Estado civil
table(data3$Estado_civil)
##
## CASADO DIVORCIADO SOLTERO UNION LIBRE VIUDO
## 486 11 327 43 3
sort(prop.table(table(data3$Estado_civil))*100, decreasing = T)
##
## CASADO SOLTERO UNION LIBRE DIVORCIADO VIUDO
## 55.8621 37.5862 4.9425 1.2644 0.3448
Participación por Departamento
#Departamento
table(data3$Departamento)
##
## ANTIOQUIA BOGOTA D.C. CALDAS CUNDINAMARCA
## 333 420 1 3
## SANTIAGO DE CALI VALLE DEL CAUCA
## 3 110
sort(prop.table(table(data3$Departamento))*100, decreasing = T)
##
## BOGOTA D.C. ANTIOQUIA VALLE DEL CAUCA CUNDINAMARCA
## 48.2759 38.2759 12.6437 0.3448
## SANTIAGO DE CALI CALDAS
## 0.3448 0.1149
Se evidencia mayor participación en los departamentos de Bogotá D.C y Antioquia respectivamente.
Partipacipación por franquicias
#Franquicias
table(data3$Franquicia)
##
## AMEX MASTER VISA
## 247 122 501
sort(prop.table(table(data3$Franquicia))*100, decreasing = T)
##
## VISA AMEX MASTER
## 57.59 28.39 14.02
plot_ly(data3, x = ~Franquicia, type = "histogram")%>% config(displayModeBar = F)
Con una participación del 57,5% Visa es la franquicia que registra mas transacciones acumuladas en los usuarios entre el 2017 y el 2019.
Canal
#Canal
table(data3$canal)
##
## I Ninguno P
## 393 1 476
sort(prop.table(table(data3$canal))*100, decreasing = T)
##
## P I Ninguno
## 54.7126 45.1724 0.1149
Se evidencia mayor participación en pagos presenciales (54,7%) en comparación por pagos en internet (45,1%).
Distribución por canal según el nivel de estudio
Medio de pago Presente
data_p<-data3 %>% filter(canal=="P")
data_I<-data3 %>% filter(canal=="I")
plot_ly(data_p, x = ~Nivel_estudio, y= ~canal, type = "histogram")%>% config(displayModeBar = F)
Medio de pago Internet
plot_ly(data_I, x = ~Nivel_estudio, y= ~canal, type = "histogram")%>% config(displayModeBar = F)
Las personas que tienen además de un pregrado otros estudios, tienden a usar mas el internet como medio de pago con el uso de las tarjetas de crédito.
Origen
#Origen
table(data3$origen)
##
## Internacional Nacional Ninguno
## 236 633 1
sort(prop.table(table(data3$origen))*100, decreasing = T)
##
## Nacional Internacional Ninguno
## 72.7586 27.1264 0.1149
Distribución por estrato
table(data3$Estrato)
##
## 2 3 4 5 6
## 1 1 312 274 282
sort(prop.table(table(data3$Estrato))*100, decreasing = T)
##
## 4 6 5 2 3
## 35.8621 32.4138 31.4943 0.1149 0.1149
plot_ly(data3, x = ~Estrato, type = "histogram")%>% config(displayModeBar = F)
La gran población esta entre estrato 4 y 6
Reclamos acumulados
table(data3$Reclamos)
##
## 2 3 6
## 438 430 2
sort(prop.table(table(data3$Reclamos))*100, decreasing = T)
##
## 2 3 6
## 50.3448 49.4253 0.2299
plot_ly(data3, x = ~Reclamos, type = "histogram")%>% config(displayModeBar = F)
Distribución por hijos
#hijos
plot_ly(data3, y = ~Hijos, type = "box", name = "Num Hijos")
plot_ly(data3, x = ~Hijos, type = "histogram")%>% config(displayModeBar = F)
Distribución por total de transacciones acumuladas
#Distribucion del total de trx acum
plot_ly(data3, x = ~Total_trx, type = "histogram")%>% config(displayModeBar = F)
Para mirar la relación entre las variables numéricas, se realizará un análisis con la matriz de correlaciones.
Este análisis aporta el conocimiento de las relaciones directas o indirectas con el aumento de la frecuencia de transacciones de las personas.
Correlación todas las variables
cor(select(data3, "Edad", "Rango_ingresos_acum", "Monto_transado", "Total_trx"))
## Edad Rango_ingresos_acum Monto_transado Total_trx
## Edad 1.000000 0.01772 0.002128 0.027350
## Rango_ingresos_acum 0.017722 1.00000 0.308474 -0.017302
## Monto_transado 0.002128 0.30847 1.000000 -0.005797
## Total_trx 0.027350 -0.01730 -0.005797 1.000000
Cuando se realiza el análisis de correlaciones entre todas las variables se evidencia una fuerte correlación positiva entre monto transado y Rango de ingresos, lo cual tiene coherencia entre más ingresos tiene la persona gastará mas.
Adicionalmente se observa que la edad no tiene fuerte correlación con ninguna de las variables, podemos decir que la edad no es un factor significativo a la hora de saber si la persona tiene mas capacidad adquisitiva y por lo tanto sus transacciones aumentarán. Matriz gráfica
chart.Correlation(select(data3, "Edad", "Rango_ingresos_acum", "Monto_transado", "Total_trx"),histogram = TRUE, pch=19)
Correlaciones dejando fija la variable Total_trx
Total_trx vs Edad
cor(select(data3, "Total_trx","Edad"))
## Total_trx Edad
## Total_trx 1.00000 0.02735
## Edad 0.02735 1.00000
chart.Correlation(select(data3, "Edad", "Total_trx"),histogram = TRUE, pch=19)
Total_trx vs Rango_ingresos_acum
cor(select(data3, "Total_trx","Rango_ingresos_acum"))
## Total_trx Rango_ingresos_acum
## Total_trx 1.0000 -0.0173
## Rango_ingresos_acum -0.0173 1.0000
chart.Correlation(select(data3, "Rango_ingresos_acum","Total_trx"),histogram = TRUE, pch=19)
Total_trx vs Monto_transado
cor(select(data3, "Total_trx","Monto_transado"))
## Total_trx Monto_transado
## Total_trx 1.000000 -0.005797
## Monto_transado -0.005797 1.000000
chart.Correlation(select(data3, "Monto_transado","Total_trx"),histogram = TRUE, pch=19)
Por lo anterior, se puede evidenciar que ni la edad, el rango de ingresos o el monto transado son variables que estan directamente relacionadas con las transacciones acumuladas.
Hoy en día para cualquier empresa, segmentar es una manera de dividir un problema en partes más sencillas que ayuda a priorizar esfuerzos y a localizar oportunidades de negocio.
Se puede evidenciar que no todos los clientes son iguales ni tienen las mismas capacidades adquisitivas por lo tanto, es importante entender e identificar valor de grupos de individuos.
Definición Segmentar es dividir una población en grupos homogéneos en función de necesidades, comportamientos, características o actitudes y caracterizar a los grupos resultantes para saber qué les distingue entre sí.
Aplicación para el caso de estudio
Con la metodología K-Means se desea responder algunas preguntas de negocio que son importantes para la creación de estrategias para el aumento de valor de la compañia.
Con K-Means se quiere responder los siguientes cuestionamientos.
Desarrollo
Para realizar el modelo los clientes deben tener como mínimio una transacción acumulada y luego se seleccionan las variables numéricas del dataset para la clusterización.
Se segmento de acuerdo a: - Edad - Rango Ingresos - Monto transado - Total trx acumuladas
# transacciones mayores que cero
data3<-data3 %>% filter(Total_trx>0)
#Selección del k optimo = 3: edad, rango_ingresos, monto, total trx
fviz_nbclust(data3[,c(5,9,14,41)], kmeans, method = "gap_stat")
Modelo con k=3
#modelo kmeans
ModeloKMEANS <- kmeans(data3[,c(5,9,14,41)],3)
ModeloKMEANS
## K-means clustering with 3 clusters of sizes 260, 521, 88
##
## Cluster means:
## Rango_ingresos_acum Edad Monto_transado Total_trx
## 1 30684231 44.29 16459302 179.3
## 2 9120058 43.60 8063690 163.9
## 3 22377273 44.74 61446961 146.4
##
## Clustering vector:
## [1] 1 1 1 1 1 1 1 1 1 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 1 3 1 1 2 1 3 2 3
## [36] 2 3 2 2 2 3 2 2 2 2 2 2 3 2 2 2 2 2 3 1 3 1 1 3 1 1 1 1 2 2 2 2 2 2 2
## [71] 2 2 2 2 2 2 2 3 1 1 1 1 2 3 2 2 1 2 2 2 2 2 2 2 2 1 3 1 1 1 1 1 1 2 2
## [106] 3 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 1 1 1 1 1 3 1 3 1 1 1 3 2 2 3 2 2 2 2
## [141] 2 2 2 2 2 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 3 1 1 1 1 1 1 1 1 2
## [176] 1 1 1 2 1 1 3 2 2 2 2 2 2 2 2 3 1 1 1 1 3 1 1 2 2 2 2 2 2 2 2 2 2 2 2
## [211] 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 2 1 3 1 1 1 3 2 2 2 2 2 2 2 2 2 2 2 3 2
## [246] 2 2 2 2 2 3 1 1 3 1 1 1 1 1 1 1 1 3 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [281] 2 2 2 2 2 1 1 1 1 1 1 1 1 2 1 1 3 2 2 2 2 2 2 2 3 2 2 2 2 2 2 3 2 2 2
## [316] 2 1 1 1 1 1 1 1 1 1 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 2 2 3 2 3 2 2 2 2
## [351] 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 3 1 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2
## [386] 2 2 1 1 1 1 1 1 1 1 2 3 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2
## [421] 2 2 2 2 1 3 1 1 1 1 1 1 1 2 2 3 3 2 3 2 2 2 2 3 2 2 2 2 2 2 2 2 2 1 1
## [456] 1 3 1 1 1 2 1 3 1 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 1 1 1 1 1 1 3 1 1 1 1
## [491] 1 3 1 1 3 2 2 2 1 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 3 3 1 1
## [526] 3 3 2 1 2 2 2 3 3 2 2 2 2 2 2 2 3 2 2 2 2 2 3 2 2 2 1 1 1 1 3 2 2 2 2
## [561] 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 3 1 1 1 1 2 2 1 1 1 3 3 2 2 2 2
## [596] 2 2 2 2 2 2 2 1 1 1 3 3 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1
## [631] 1 1 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 3 1 1 1 2 2 2 2 2 2 2 2 2 2 2
## [666] 2 2 2 2 2 2 1 1 1 1 3 1 1 3 3 1 2 3 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 1 1
## [701] 3 1 3 1 1 1 1 2 3 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 3 2 2 2 2 2
## [736] 2 2 2 2 2 2 1 1 3 3 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 2
## [771] 2 2 2 3 2 2 2 3 2 2 2 1 1 1 1 2 2 3 2 2 2 2 2 2 2 2 2 1 1 2 2 2 2 3 2
## [806] 2 2 2 2 2 2 2 2 2 2 1 1 3 1 1 1 2 1 2 3 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1
## [841] 1 1 2 2 2 2 2 2 2 2 2 2 2 2 1 1 2 1 2 2 2 2 3 2 2 2 2 3 2
##
## Within cluster sum of squares by cluster:
## [1] 50621271974271128 40616746895220960 41627009661003544
## (between_SS / total_SS = 69.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss"
## [5] "tot.withinss" "betweenss" "size" "iter"
## [9] "ifault"
Gráfica del modelo
km.res <- kmeans(data3[,c(5,9,14,41)], 3)
fviz_cluster(km.res, data = data3[,c(5,9,14,41)], frame.type = "convex")
## Warning: argument frame is deprecated; please use ellipse instead.
## Warning: argument frame.type is deprecated; please use ellipse.type
## instead.
Distribución de clusters
cluster<-km.res$cluster
cluster
## [1] 3 3 3 3 3 3 3 3 3 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 3 1 3 3 2 3 1 2 1
## [36] 2 1 2 2 2 1 2 2 2 2 2 2 1 2 2 2 2 2 1 3 1 3 3 1 3 3 3 3 2 2 2 2 2 2 2
## [71] 2 2 2 2 2 2 2 1 3 3 3 3 2 1 2 2 3 2 2 2 2 2 2 2 2 3 1 3 3 3 3 3 3 2 2
## [106] 1 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 3 3 3 3 3 1 3 1 3 3 3 1 2 2 1 2 2 2 2
## [141] 2 2 2 2 2 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 1 3 3 3 3 3 3 3 3 2
## [176] 3 3 3 2 3 3 1 2 2 2 2 2 2 2 2 1 3 3 3 3 1 3 3 2 2 2 2 2 2 2 2 2 2 2 2
## [211] 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 2 3 1 3 3 3 1 2 2 2 2 2 2 2 2 2 2 2 1 2
## [246] 2 2 2 2 2 1 3 3 1 3 3 3 3 3 3 3 3 1 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [281] 2 2 2 2 2 3 3 3 3 3 3 3 3 2 3 3 1 2 2 2 2 2 2 2 1 2 2 2 2 2 2 1 2 2 2
## [316] 2 3 3 3 3 3 3 3 3 3 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 2 2 1 2 1 2 2 2 2
## [351] 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 1 3 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2
## [386] 2 2 3 3 3 3 3 3 3 3 2 1 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2
## [421] 2 2 2 2 3 1 3 3 3 3 3 3 3 2 2 1 1 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 3 3
## [456] 3 1 3 3 3 2 3 1 3 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 3 3 3 3 3 3 1 3 3 3 3
## [491] 3 1 3 3 1 2 2 2 3 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 1 1 3 3
## [526] 1 1 2 3 2 2 2 1 1 2 2 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 3 3 3 3 1 2 2 2 2
## [561] 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 1 3 3 3 3 2 2 3 3 3 1 1 2 2 2 2
## [596] 2 2 2 2 2 2 2 3 3 3 1 1 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3
## [631] 3 3 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 1 3 3 3 2 2 2 2 2 2 2 2 2 2 2
## [666] 2 2 2 2 2 2 3 3 3 3 1 3 3 1 1 3 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 3 3
## [701] 1 3 1 3 3 3 3 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 1 2 2 2 2 2
## [736] 2 2 2 2 2 2 3 3 1 1 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 2
## [771] 2 2 2 1 2 2 2 1 2 2 2 3 3 3 3 2 2 1 2 2 2 2 2 2 2 2 2 3 3 2 2 2 2 1 2
## [806] 2 2 2 2 2 2 2 2 2 2 3 3 1 3 3 3 2 3 2 1 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3
## [841] 3 3 2 2 2 2 2 2 2 2 2 2 2 2 3 3 2 3 2 2 2 2 1 2 2 2 2 1 2
Creación de la columna Cluster para el dataset y distribución por grupo
data3$Grupo_cluster <- ModeloKMEANS$cluster
table(data3$Grupo_cluster)
##
## 1 2 3
## 260 521 88
sort(prop.table(table(data3$Grupo_cluster))*100, decreasing = T)
##
## 2 1 3
## 59.95 29.92 10.13
Se realizó una segmentación con un k óptimo = 3, donde el grupo 2 tiene mayor participación del 59,9%, mientras que el grupo 1 tiene el 29,9% y el el grupo 3 con una participación del 10,13% según la cantidad de la población seleccionada.
Estadísticas por cada cluster
G1<-data3 %>% select(Edad, Rango_ingresos_acum, Monto_transado, Total_trx,Grupo_cluster) %>% filter(Grupo_cluster==1)
summary(G1)
## Edad Rango_ingresos_acum Monto_transado Total_trx
## Min. :26.0 Min. :15000000 Min. : 65418 Min. : 4
## 1st Qu.:38.0 1st Qu.:24000000 1st Qu.: 8897368 1st Qu.: 46
## Median :45.0 Median :27150000 Median :14513316 Median : 91
## Mean :44.3 Mean :30684231 Mean :16459302 Mean : 179
## 3rd Qu.:52.0 3rd Qu.:36000000 3rd Qu.:23046245 3rd Qu.: 201
## Max. :60.0 Max. :69000000 Max. :41314956 Max. :3078
## Grupo_cluster
## Min. :1
## 1st Qu.:1
## Median :1
## Mean :1
## 3rd Qu.:1
## Max. :1
G2<-data3 %>% select(Edad, Rango_ingresos_acum, Monto_transado, Total_trx,Grupo_cluster) %>% filter(Grupo_cluster==2)
summary(G2)
## Edad Rango_ingresos_acum Monto_transado Total_trx
## Min. :25.0 Min. : 600000 Min. : 21553 Min. : 3
## 1st Qu.:36.0 1st Qu.: 4500000 1st Qu.: 2953731 1st Qu.: 41
## Median :44.0 Median : 7500000 Median : 5562137 Median : 80
## Mean :43.6 Mean : 9120058 Mean : 8063690 Mean : 164
## 3rd Qu.:51.0 3rd Qu.:12000000 3rd Qu.:11647922 3rd Qu.: 222
## Max. :60.0 Max. :24000000 Max. :36880460 Max. :2094
## Grupo_cluster
## Min. :2
## 1st Qu.:2
## Median :2
## Mean :2
## 3rd Qu.:2
## Max. :2
G3<-data3 %>% select(Edad, Rango_ingresos_acum, Monto_transado, Total_trx,Grupo_cluster) %>% filter(Grupo_cluster==3)
summary(G3)
## Edad Rango_ingresos_acum Monto_transado Total_trx
## Min. :25.0 Min. : 4500000 Min. :37455947 Min. : 7
## 1st Qu.:37.8 1st Qu.:13125000 1st Qu.:46770714 1st Qu.: 37
## Median :44.0 Median :20550000 Median :58545560 Median : 87
## Mean :44.7 Mean :22377273 Mean :61446961 Mean : 146
## 3rd Qu.:53.0 3rd Qu.:27375000 3rd Qu.:72983372 3rd Qu.: 163
## Max. :60.0 Max. :90000000 Max. :98580554 Max. :1238
## Grupo_cluster
## Min. :3
## 1st Qu.:3
## Median :3
## Mean :3
## 3rd Qu.:3
## Max. :3
Se observa que el cluster 1, cuenta con clientes que han tenido un máximo de transacciones de 3078 y con montro máximo transado de mas de 400 millones, se podría decir que las personas que están en este grupo son mas propensas a transar mas y sus gastos son mayores, por lo tanto este sería el grupo potencial para fortalecer lazos comerciales y adquision de nuevos productos.
Con el cluster 2 y 3, tiene caracteristicas similares , pero adicional a esto, existen clientes que son más propensos a gastar menos por lo tanto el monto transado es menor. Estos clientes se tendrían que mirar con mayor detenimiendo si se quiere que ellos aumenten el número de transacciones y que no se fugen, se debe crear estrategias de fidelación y negociación de tarifas.